source("pgload.R")
download financial , check NA value and clear it
getSymbols("2330.tw",auto.assign = F,from = "2000-01-01") %>%
na.omit() -> `tw 2330`
## 'getSymbols' currently uses auto.assign=TRUE by default, but will
## use auto.assign=FALSE in 0.5-0. You will still be able to use
## 'loadSymbols' to automatically load data. getOption("getSymbols.env")
## and getOption("getSymbols.auto.assign") will still be checked for
## alternate defaults.
##
## This message is shown once per session and may be disabled by setting
## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details.
##
## WARNING: There have been significant changes to Yahoo Finance data.
## Please see the Warning section of '?getSymbols.yahoo' for details.
##
## This message is shown once per session and may be disabled by setting
## options("getSymbols.yahoo.warning"=FALSE).
## Warning: 2330.tw contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
names(`tw 2330`) <- c("open","high","low","close","volume","adjusted")
`tw 2330` %>%
is.na() %>%
which((.) == T)
## integer(0)
# `tw 2330`
as_data_frame(`tw 2330`) -> `tw 2330 data frame`
`tw 2330 data frame`$date <- as.Date(row.names(`tw 2330 data frame`))
`tw 2330 data frame` %>% select(date,volume,everything()) %>%
filter(volume>0) -> `tw 2330 data frame`
# filter(volume>0 |!(is.na(volume))) # volume is not na 包含 0
一星二陽K棒組合可以下列9個條件來刻劃:
1.第t天的收盤價 > 第t天的開盤價 2.第t-2天的收盤價 > 第t-2天的開盤價 3.第t天的開盤價 > 第t-1天的收盤價(1-0.01) 4.第t天的開盤價 < 第t-1天的收盤價(1+0.01)
5.第t-2天的收盤價 > 第t-1天的開盤價*(1-0.01)
6.第t-2天的收盤價 < 第t-1天的開盤價*(1+0.01) 7.第t天的實體K棒長度(漲跌)為1%以上 8.第t-1天的實體K棒長度(漲跌)為0.5%以下 9.第t-2天的實體K棒長度(漲跌)為1%以上
編寫交易條件 并且建搆 進場時間與價格
`tw 2330 data frame` %>%
mutate(
lastC = lag(close,1) , # last day
aflastC = lag(close,2) , # after last day
lastO = lag(open,1) , # last open
aflastO = lag(open,2), # after last day open
kbar = abs( close/open -1),
lastKbar = lag(kbar,1) ,
aflastKbar = lag(kbar,2)
) %>%
filter(
close > open , #1
aflastC > aflastO , #2
open > lastC*0.09 , #3
open < lastC*1.01 , #4
aflastC > lastO * 0.09 , #5
aflastC < lastO * 1.01 , #6
kbar > 0.01 , #7
lastKbar < 0.005 , #8
aflastKbar > 0.01 #9
) %>%
select(indate = date ,buyprice = close) -> `insite table`
發生收盤價跌破20日移動平均線的位置。收盤價跌破20日移動平均線在程式中的判斷條件為:
t日的收盤價 < t日的20日移動平均線 t-1日的收盤價 > t-1日的20日移動平均線
建搆 出場時間與價格
`tw 2330 data frame` %>%
mutate(
sma20 = SMA(close,20) ,
lastsm20 = sma20 ,
lastC = lag(close,1)
) %>%
filter(
close < sma20 ,
lastC > lastsm20
) %>%
select(outdate =date , sellprice = close) -> `outsite table`
`outsite table` %>%
head
## # A tibble: 6 x 2
## outdate sellprice
## <date> <dbl>
## 1 2000-02-21 76.3
## 2 2000-03-02 79.4
## 3 2000-03-22 75.1
## 4 2000-04-13 75.1
## 5 2000-05-02 75.5
## 6 2000-05-03 73.6
`insite table` %>%
head
## # A tibble: 6 x 2
## indate buyprice
## <date> <dbl>
## 1 2000-01-28 79.8
## 2 2001-08-14 48.4
## 3 2001-09-04 46.3
## 4 2001-10-18 41.7
## 5 2002-10-17 33.6
## 6 2002-12-26 35.5
`trade detail table` <- NULL
for(ix in 1:nrow(`insite table`)){
indate <- `insite table`$"indate"[ix] # 取進場的日期
`outsite table` %>% # 把出場的日期向量化
.$"outdate" -> outdate
outsite <- which(outdate > indate)[1] # 把進場日期與 出場日期做比較拿最近時間
if(length(outsite)>0){ # 假如出場時間存在(用長度判斷)
# = 0 代表沒有出場時間
# 合并進場與出場時間
`trade detail table` = bind_rows(
`trade detail table` , bind_cols(
`insite table`[ix,] , `outsite table`[outsite,]
)
)
}
}
`trade detail table` %>%
head
## # A tibble: 6 x 4
## indate buyprice outdate sellprice
## <date> <dbl> <date> <dbl>
## 1 2000-01-28 79.8 2000-02-21 76.3
## 2 2001-08-14 48.4 2001-08-22 43.5
## 3 2001-09-04 46.3 2001-09-06 44.9
## 4 2001-10-18 41.7 2001-12-21 56.1
## 5 2002-10-17 33.6 2002-11-20 35.6
## 6 2002-12-26 35.5 2003-02-06 34.2
一星二陽K棒組合策略績效分析
計算每次交易的報酬率。含交易成本的報酬率算法為:
Ret= Ps???(1???Cs)/Pb???(1+Cb) ???1
其中,Pb和Ps分別為買入價格及賣出價格,Cb和Cs則是買入和賣出交易成本,此處買賣交易成本設定為千分之二。
`buy cost` <- 0.002
`close cost` <- 0.002
`trade detail table` %>%
mutate(
ret = (sellprice*(1-`close cost`) / buyprice*(1+`buy cost`) )-1 ,
holddays = as.numeric(outdate-indate)
) -> `trade detail table`
`trade detail table` %>%
head
## # A tibble: 6 x 6
## indate buyprice outdate sellprice ret holddays
## <date> <dbl> <date> <dbl> <dbl> <dbl>
## 1 2000-01-28 79.8 2000-02-21 76.3 -0.0441 24
## 2 2001-08-14 48.4 2001-08-22 43.5 -0.101 8
## 3 2001-09-04 46.3 2001-09-06 44.9 -0.0303 2
## 4 2001-10-18 41.7 2001-12-21 56.1 0.345 64
## 5 2002-10-17 33.6 2002-11-20 35.6 0.0598 34
## 6 2002-12-26 35.5 2003-02-06 34.2 -0.0348 42
策略績效表現衡量的指標,大致上有:
1.平均報酬率 2.交易次數 3.勝率 4.報酬率標準差 5.最大報酬率 6.最小報酬率 7.平均持有日數
`trade detail table` %>%
summarise(
mean = mean(ret),
num = NROW(indate), # 2.這個策略交易的數量
`win rate %` = (sum(ret>0)/num)*100,
sd = sd(ret) ,
`max rate` = max(ret),
`min rate` = min(ret),
`mean holddays` = mean(holddays)
)
## # A tibble: 1 x 7
## mean num `win rate %` sd `max rate` `min rate` `mean holddays`
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.000371 34 29.4 0.0736 0.345 -0.101 22.5
繪圖前提準備
`tw 2330 data frame` %>%
mutate(
sma5 = SMA(close,5),
sma20 = SMA(close,20),
sma60 = SMA(close,60)
) -> `tw 2330 data frame`
plotsample <- 1
`trade detail table` %>% head
## # A tibble: 6 x 6
## indate buyprice outdate sellprice ret holddays
## <date> <dbl> <date> <dbl> <dbl> <dbl>
## 1 2000-01-28 79.8 2000-02-21 76.3 -0.0441 24
## 2 2001-08-14 48.4 2001-08-22 43.5 -0.101 8
## 3 2001-09-04 46.3 2001-09-06 44.9 -0.0303 2
## 4 2001-10-18 41.7 2001-12-21 56.1 0.345 64
## 5 2002-10-17 33.6 2002-11-20 35.6 0.0598 34
## 6 2002-12-26 35.5 2003-02-06 34.2 -0.0348 42
indate <- `trade detail table`$indate[plotsample]
outdate <- `trade detail table`$outdate[plotsample]
matchsite <- which(`tw 2330 data frame`$date == indate)-35
plotStarDate <- `tw 2330 data frame`$date[
ifelse(
matchsite<1,
1,matchsite
)
] # 避免超出範圍 , 因???-35 如果是負數 , 那就取date[1]
matchsite <- which(`tw 2330 data frame`$date == outdate) +35
plotEndDate <- `tw 2330 data frame`$date[
ifelse(
NROW(`tw 2330 data frame`$date) < matchsite ,
NROW(`tw 2330 data frame`$date) , matchsite
)
]
`tw 2330 data frame` %>%
filter(
date >= plotStarDate & date <= plotEndDate
) -> tw2330
# 標準進場價位
rep(NA,length(tw2330$date)) -> tw2330$insite
tw2330$open[which(tw2330$date==(indate))-1] *0.97 -> tw2330$insite[which(tw2330$date==indate)] # 進場前一天通知
# 標注出場價位
rep(NA,length(tw2330$date)) -> tw2330$outsite
tw2330$close[which(tw2330$date==(outdate))-1] * 1.03 -> tw2330$outsite[which(tw2330$date==outdate)] # 出場前一天通知
xts(tw2330[,-1],order.by = as.Date(tw2330$date)) -> `tw2330 xts`
chart_theme() -> mytheme
mytheme$col$dn.col <- "red"
mytheme$col$up.col <- "white"
chart_Series(`tw2330 xts`,theme = mytheme)
add_Vo()
add_TA(`tw2330 xts`$sma5,col = "black",on=1)
add_TA(`tw2330 xts`$sma20,col="blue",on=1)
add_TA(`tw2330 xts`$sma60,col="pink",on=1)
add_TA(`tw2330 xts`$insite,col="black",on=1,pch=2,cex=5,type="p")
add_TA(`tw2330 xts`$outsite,col="red",on=1,pch=6,cex=5,type="p")
使用 ggplot2 轉成 plotly 觀察每者之間的變化
把程式碼 func 化
`sma Analysis` <- function(plotsample=1,graph="quantmod"){
indate <- `trade detail table`$indate[plotsample]
outdate <- `trade detail table`$outdate[plotsample]
matchsite <- which(`tw 2330 data frame`$date == indate)-35
plotStarDate <- `tw 2330 data frame`$date[
ifelse(
matchsite<1,
1,matchsite
)
] # 避免超出範圍 , 因???-35 如果是負數 , 那就取date[1]
matchsite <- which(`tw 2330 data frame`$date == outdate) +35
plotEndDate <- `tw 2330 data frame`$date[
ifelse(
NROW(`tw 2330 data frame`$date) < matchsite ,
NROW(`tw 2330 data frame`$date) , matchsite
)
]
`tw 2330 data frame` %>%
filter(
date >= plotStarDate & date <= plotEndDate
) -> tw2330
# 標準進場價位
rep(NA,length(tw2330$date)) -> tw2330$insite
tw2330$open[which(tw2330$date==(indate))-1] *0.97 -> tw2330$insite[which(tw2330$date==indate)] # 進場前一天通知
# 標注出場價位
rep(NA,length(tw2330$date)) -> tw2330$outsite
tw2330$close[which(tw2330$date==(outdate))-1] * 1.03 -> tw2330$outsite[which(tw2330$date==outdate)] # 出場前一天通知
xts(tw2330[,-1],order.by = as.Date(tw2330$date)) -> `tw2330 xts`
if(graph=="quantmod"){
chart_theme() -> mytheme
mytheme$col$dn.col <- "red"
mytheme$col$up.col <- "white"
chart_Series(`tw2330 xts`,theme = mytheme)
add_Vo()
add_TA(`tw2330 xts`$sma5,col = "black",on=1)
add_TA(`tw2330 xts`$sma20,col="blue",on=1)
add_TA(`tw2330 xts`$sma60,col="pink",on=1)
add_TA(`tw2330 xts`$insite,col="black",on=1,pch=2,cex=5,type="p")
add_TA(`tw2330 xts`$outsite,col="red",on=1,pch=6,cex=5,type="p")
}else{
tw2330 %>%
ggplot(aes(date)) +
geom_pointrange(aes(y=close,
ymin=low,
ymax=high,
color=-close
),
show.legend = F,
shape=3
) +
geom_line(aes(y=sma5),color="red") +
geom_line(aes(y=sma20),color="orange")+
geom_line(aes(y=sma60),color="black")+
labs(title = "morning star") +
geom_point(aes(y=insite),color="black",size=3,shape=2) +
geom_point(aes(y=outsite),color="black",size=3,shape=6) -> p
ggplotly(p)
}
}
`sma Analysis`(3)
`sma Analysis`(3,graph = "plotly")